(defun get-char (string index)
  (char string index))

(defun string-length (string)
  (length string))

(defun append-last (lst element)
  (append (butlast lst)
          (list
            (append
              (car (last lst))
              (list element)))))

(defun merge-last (lst)
  (let ((else (butlast (butlast lst)))
        (merge-from (last lst))
        (merge-to (car (last (butlast lst)))))
    (append else
            (list
              (append merge-to
                      merge-from)))))

(defun add-to-word (word char)
  (concatenate 'string
               word
               (string char)))

; This is a simple list parser.
; status: 'go 'word 'string
(defun list-parser (source-code)
  (let ((word nil)
        (result '())
        (result-stack '())
        (status 'go)
        (paren-level 0)
        (str-len (string-length source-code)))
    (dotimes (index str-len)
      (let ((current-char (get-char source-code index)))
        (cond ((eq status 'go)
               (progn
                 (cond ((eq #\( current-char)
                        (progn
                          (incf paren-level)
                          (setf result-stack
                                (append result-stack (list nil)))))
                       ((eq #\) current-char)
                        (progn
                          (setf result-stack
                                (merge-last result-stack))
                          (decf paren-level)))
                       ((eq #\" current-char)
                        (progn
                          (setf status 'string)
                          (setf word (add-to-word word current-char))))
                       ((eq #\Space current-char)
                        'do-nothing)
                       ((eq #\Tab current-char)
                        'do-nothing)
                       ((eq #\Newline current-char)
                        'do-nothing)
                       (t
                        (progn
                          (setf status 'word)
                          (setf word (add-to-word word current-char)))))))
              ((eq status 'string)
               (progn
                 (cond ((eq #\" current-char)
                        (progn
                          (setf word (add-to-word word current-char))
                          (setf status 'go)
                          (setf result-stack
                                (append-last result-stack
                                             (cons 'string word)))
                          (setf word nil)))
                       (t
                        (setf word (add-to-word word current-char))))))
              ((eq status 'word)
               (progn
                 (cond ((eq #\Space current-char)
                        (progn
                          (setf status 'go)
                          (setf result-stack
                                (append-last result-stack
                                             (cons 'word word)))
                          (setf word nil)))
                       ((eq #\) current-char)
                        (progn
                          (setf status 'go)
                          (setf result-stack
                                (append-last result-stack
                                             (cons 'word word)))
                          (setf word nil)
                          (setf result-stack
                                (merge-last result-stack))
                          (decf paren-level)))
                       (t
                        (setf word (add-to-word word current-char)))))))))
    (if (not (= paren-level 0))
      (error "list-parser: Error, unmatched close parenthesis"))
    (car result-stack)))
